home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / phone.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-02-26  |  7.6 KB  |  283 lines
  1. Program Phone;
  2.  
  3. Type
  4.    String15    = String[15];
  5.    NumNodePtr  = ^NumNode;
  6.    NumNode     = Record
  7.                     Name,Number : String15;
  8.                     Next        : NumNodePtr;
  9.                  End;
  10.    NumRecType  = Record
  11.                     Name, Number : String15
  12.                  End;
  13.  
  14. Var
  15.    Base, Cur  : NumNodePtr;
  16.    NumFile    : File of NumRecType;
  17.    Done       : Boolean;
  18.  
  19. {      Init will fetch the info from phone.lst and form a linked list
  20.   with it.  If the file does not exist, it will create it instead.    }
  21.  
  22. Procedure Init;
  23. Var
  24.    NumRec    : NumRecType;
  25.    FirstUse  : Boolean;
  26.    Num       : Integer;
  27. Begin
  28.    Done := False;
  29.    Assign(NumFile,'Phone.lst');
  30.    Base := Nil;
  31.    Cur := Base;
  32.    {$I-} Reset(NumFile) {$I+};
  33.    FirstUse := (IOResult <> 0);
  34.    If FirstUse then Rewrite(NumFile)
  35.    Else
  36.       While not(EOF(NumFile)) do
  37.          Begin
  38.             If Cur = Nil then          { Create base node }
  39.                Begin
  40.                   New(Cur);
  41.                   Base := Cur
  42.                End
  43.             Else                       { Create non base node }
  44.                Begin
  45.                   New(Cur^.Next);
  46.                   Cur := Cur^.Next;
  47.                End;
  48.             Read(NumFile,NumRec);      { Fill list node from file }
  49.             Cur^.Name := NumRec.Name;
  50.             Cur^.Number := NumRec.Number;
  51.             Cur^.Next := Nil
  52.          End;
  53.    Close(NumFile);
  54. End;
  55.  
  56. {      UpdateFile will save the linked list in virtual memory to disk
  57.   into Phone.lst on thecurrent directory                               }
  58.  
  59. Procedure UpdateFile;
  60. Var
  61.    Num    : Integer;
  62.    c      : NumNodePtr;
  63.    NumRec : NumRecType;
  64. Begin
  65.    c := Base;
  66.    Rewrite(NumFile);
  67.    NumRec.Name := ''; NumRec.Number := '';
  68.    For Num := 1 to 100 do Write(NumFile,NumRec);
  69.    Rewrite(NumFile);
  70.    While c <> Nil do
  71.       Begin
  72.          NumRec.Name := c^.Name;
  73.          NumRec.Number := c^.Number;
  74.          Write(NumFile,NumRec);
  75.          c := c^.Next
  76.       End;
  77.    Close(NumFile);
  78. End;
  79.  
  80. Procedure AddNode;
  81. Var
  82.    Name,Number : String15;
  83.    c,p,Temp    : NumNodePtr;
  84. Begin
  85.    ClrScr;
  86.    GotoXY(10,10); Write('Enter name   : '); Readln(Name);
  87.    GotoXY(10,12); Write('Enter number : '); Readln(Number);
  88.    c := Base;
  89.    While (not((Name > c^.Name) and (Name < c^.Next^.Name)))
  90.          and (c <> Nil) and (Name > c^.Name) DO
  91.       Begin
  92.          p := c;
  93.          c := c^.Next;
  94.       End;
  95.    If c = Nil then             { Add node to end of list }
  96.       Begin
  97.          New(c);
  98.          If Base = Nil then Base := c
  99.          Else p^.Next := c;
  100.          c^.Next := Nil;
  101.          c^.Name := Name;
  102.          c^.Number := Number;
  103.       End
  104.    Else If (c = Base) and (c^.Name > Name) then
  105.       Begin                    { Add node to begining of list }
  106.          New(c);
  107.          c^.Name := Name;
  108.          c^.Number := Number;
  109.          c^.Next := Base;
  110.          Base := c
  111.       End
  112.    Else                       { Add node into middle of list }
  113.       Begin
  114.          Temp := c^.Next;
  115.          c^.Next := nil;
  116.          New(c^.Next);
  117.          c^.Next^.Name := Name;
  118.          c^.Next^.Number := Number;
  119.          c^.Next^.Next := Temp;
  120.       End;
  121. End;
  122.  
  123. Procedure PrintList;
  124. Var
  125.    x     : Char;
  126.    c     : NumNodePtr;
  127.    str   : String15;
  128.    num,i : Integer;
  129. Begin
  130.    ClrScr;
  131.    GotoXY(10,10);Write('Send output to printer ? ');Readln(x);
  132.    c := Base;
  133.    If x in ['y','Y'] then
  134.       Begin
  135.          Writeln(lst);Writeln(lst);
  136.          Writeln(lst,'             Name         Phone Number   ');
  137.          Writeln(lst,'            ------       --------------  ');
  138.          Writeln(lst);
  139.       End
  140.    Else
  141.       Begin
  142.          Writeln;Writeln;
  143.          GotoXY(10,13);Writeln('     Name        Phone Number   ');
  144.          GotoXY(10,14);Writeln('    ------      --------------  ');
  145.          Writeln;
  146.       End;
  147.    While c <> Nil do
  148.       Begin
  149.          num := 15 - length(c^.Name);
  150.          str := ' ';
  151.          For i := 1 to num do str := str + ' ';
  152.          If x in ['y','Y'] then
  153.             Writeln(lst,'          ',c^.Name,str,c^.Number)
  154.          Else
  155.             Writeln('           ',c^.Name,str,c^.Number);
  156.          c := c^.Next
  157.       End;
  158.    Writeln;Writeln('          Hit return to continue');Read(x);
  159. End;
  160.  
  161. Procedure FindNode(Var p : NumNodePtr;Str : String15);
  162. Var
  163.    Size  : Integer;
  164.    Match : String15;
  165.    c     : NumNodePtr;
  166. Begin
  167.    Size := Length(Str);
  168.    c := Base;
  169.    p := c;
  170.    Match := Copy(c^.Name,1,Size);
  171.    While (Str <> Match) and (c <> Nil) Do
  172.       Begin
  173.          p := c;
  174.          c := c^.Next;
  175.          Match := Copy(c^.Name,1,Size)
  176.       End;
  177.    GotoXY(10,12);
  178.    If c = nil then Writeln('Name not found')
  179.    Else Writeln(c^.Name,'  ',c^.Number);
  180. End;
  181.  
  182.  
  183. Procedure Find;
  184. Var
  185.    x   : Char;
  186.    Str : String15;
  187.    c   : NumNodePtr;
  188. Begin
  189.    ClrScr;
  190.    GotoXY(10,10); Write('Name to search for : ');
  191.    Readln(Str); Writeln; Writeln;
  192.    FindNode(c,Str);
  193.    GotoXY(10,14);Writeln('Hit return to continue');Read(x);
  194. End;
  195.  
  196. Procedure DelNode;
  197. Var
  198.    Str : String15;
  199.    c,p : NumNodePtr;
  200.    x   : Char;
  201. Begin
  202.    ClrScr;
  203.    GotoXY(10,10); Write('Enter name to delete : ');
  204.    Readln(Str);
  205.    FindNode(p,Str);
  206.    If (p^.Next <> Nil) or (Copy(p^.Name,1,Length(Str)) = Str) then
  207.       Begin
  208.          GotoXY(10,14); Write('Are you sure ? ');Readln(x);
  209.          If x in ['y','Y'] then
  210.             If (p = Base) and
  211.             (Copy(p^.Name,1,Length(Str)) = Str) then  { Del Base }
  212.                Begin
  213.                   Base := p^.Next;
  214.                   Dispose(p);
  215.                End
  216.             Else                                { Del end or middle }
  217.                Begin
  218.                   c := p^.Next^.Next;
  219.                   Dispose(p^.Next);
  220.                   p^.Next := c
  221.                End;
  222.       End;
  223.    GotoXY(10,14);Writeln('Hit return to continue');Read(x);
  224. End;
  225.  
  226. Procedure Menu;
  227. Var
  228.    x : Char;
  229.    c : NumNodePtr;
  230. Begin
  231.    x := ' ';
  232.    Clrscr;
  233.    TextColor(04);
  234.    GotoXY(33,3) ; Writeln('Phone List');
  235.    GotoXY(32,4) ; Writeln('------------');
  236.    GotoXY(30,6) ; Writeln('By Gregory S Gray');
  237.    TextColor(04); GotoXY(29,09); Write('A');
  238.    TextColor(9) ; Writeln('dd to phone list.');
  239.    TextColor(04); GotoXY(29,11); Write('F');
  240.    TextColor(9) ; Writeln('ind a phone number.');
  241.    TextColor(04); GotoXY(29,13); Write('P');
  242.    TextColor(9) ; Writeln('rint the phone list.');
  243.    TextColor(04); GotoXY(29,15); Write('S');
  244.    TextColor(9) ; Writeln('ave phone list');
  245.    TextColor(04); GotoXY(29,17); Write('D');
  246.    TextColor(9) ; Writeln('elete entry');
  247.    TextColor(04); GotoXY(29,19); Write('Q');
  248.    TextColor(9) ; Writeln('uit to Dos');
  249.    TextColor(04);
  250.    While not(x in ['A','a','p','P','F','f','q','Q','s','S','d','D']) do
  251.       Begin
  252.          GotoXY(29,21);
  253.          Write('What will it be ?  ');
  254.          GotoXY(47,21);
  255.          Readln(x);
  256.       End;
  257.    Case x of
  258.       'p','P' : PrintList;
  259.       'f','F' : Find;
  260.       'a','A' : AddNode;
  261.       's','S' : UpdateFile;
  262.       'd','D' : DelNode;
  263.       'q','Q' : Begin
  264.                    GotoXY(29,23); Write('Are you sure ? ');Readln(x);
  265.                    If x in ['y','Y'] then
  266.                    Begin
  267.                       GotoXY(24,23);
  268.                       Done := True;
  269.                       Write('Do you wish to save the phone list ? ');
  270.                       Readln(x);
  271.                       If x in ['y','Y'] then UpdateFile;
  272.                    End;
  273.                 End;
  274.    End;
  275. End;
  276.  
  277. Begin
  278.    Init;
  279.    While Not(Done) do Menu;
  280. End.
  281.        If Base = Nil then Base := c
  282.          Else p^.Next := c;
  283.          c^.Next := N